unit  UBackup;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, process, Db, Dbf, sqldb, LResources, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls,
  Grids, ActnList, DbCtrls, RTTIGrids, Uconfiguracao, SynRegExpr;

type

  { TMyThread }

  TMyThread = class(TThread)
  private
    TerminarProcesso: boolean;
    StatusSaida : integer;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
  end;

  { TFormBackup }

  TFormBackup = class(TForm)
    BtnParar: TButton;
    BtnIniciar: TButton;
    ButtonConfigurar: TButton;
    ButtonSimular: TButton;
    ButtonSair: TButton;
    Datasource: TDatasource;
    DBA: TDbf;
    Dbnavigator1: Tdbnavigator;
    Dbtext1: Tdbtext;
    Groupbox1: Tgroupbox;
    Label1: Tlabel;
    Edit1: TMemo;
    LabelStatus: TLabel;
    ProgressBar: TProgressBar;
    StatusBar: TStatusBar;
    Timer: TTimer;
    TrayIcon: TTrayIcon;
    Procedure BtnPararClick(Sender: Tobject);
    Procedure BtnIniciarClick(Sender: Tobject);
    Procedure ButtonConfigurarClick(Sender: Tobject);
    Procedure ButtonSimularClick(Sender: Tobject);
    Procedure ButtonSairClick(Sender: Tobject);
    Procedure Formclosequery(Sender: Tobject; Var Canclose: Boolean);
    procedure FormCreate(Sender: TObject);
    Procedure Timertimer(Sender: Tobject);
    procedure CriarTabela(Arquivo : String);
    Procedure MontaComando(Sender: Tobject);
    Procedure IniciarBackup(Sender: Tobject);
    Procedure AtivarBotoes(Sender: Tobject);
    Procedure DestivarBotoes(Sender: Tobject);
    Procedure ImprimeStatus(Sender: Tobject);
  private
     Comando: String;
     status : String;
  public
    MyThread : TMyThread;
  end;

var
  FormBackup: TFormBackup;

implementation

{ TFormBackup }

procedure TFormBackup.FormCreate(Sender: TObject);
var
   ArquivoDb: String;
begin
  ArquivoDb := 'Backup.dbf';
  //Se não existir o db cria
  if not FileExists(ArquivoDb) then CriarTabela(ArquivoDb);
  if not DBA.Active then DBA.Active := true;
end;

Procedure TFormBackup.Timertimer(Sender: Tobject);
var
  re: TRegExpr;
Begin
  //MyThread.ShowStatus;
  re := TRegExpr.Create;
  re.Expression := '^\s+(\S+)\s+(\d+)%\s+(\S+)\s+(\S+)\s';
  if re.Exec(status) then begin
     //ShowMessage( re.Match[2] );
     ProgressBar.Position := StrToInt('11');
  End;
  re.Free;
End;

Procedure TFormBackup.IniciarBackup(Sender: Tobject);
Begin
  MyThread := TMyThread.Create(false); // With the True parameter it doesn't start automatically
  if Assigned(MyThread.FatalException) then
    raise MyThread.FatalException;
End;

Procedure TFormBackup.BtnPararClick(Sender: Tobject);
Begin
     MyThread.TerminarProcesso := true;
End;

Procedure TFormBackup.BtnIniciarClick(Sender: Tobject);
Begin
  BtnParar.Enabled := true;
  BtnIniciar.Enabled := false;
  MontaComando(nil);
  Comando := Comando + ' ' + DBA.FieldByName('ORIGEM').AsString + ' ' + DBA.FieldByName('DESTINO').AsString;
  IniciarBackup(nil);
   MyThread.TerminarProcesso := false;
End;

Procedure TFormBackup.ButtonConfigurarClick(Sender: Tobject);
Begin
    Application.Createform(Tfconfiguracao, Fconfiguracao);
    FConfiguracao.Show;
    Visible := false;
End;

Procedure TFormBackup.MontaComando(Sender: Tobject);
Begin
   Comando := ' --verbose --archive ';
   if DBA.FieldByName('CONFIG_LIM').AsInteger > 0 then begin
      Comando := Comando + '--bwlimit=' + DBA.FieldByName('CONFIG_LIM').AsString + ' ';
   end else
   if DBA.FieldByName('CONFIG_1').AsBoolean then begin
      Comando := Comando + '--owner ';
   end else if DBA.FieldByName('CONFIG_2').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_3').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_4').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_5').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_6').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_7').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_8').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_9').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_10').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_11').AsBoolean then begin
      Comando := Comando + '';
   end else if DBA.FieldByName('CONFIG_12').AsBoolean then begin
      Comando := Comando + '';
   End;
End;

Procedure TFormBackup.AtivarBotoes(Sender: Tobject);
Begin
  ButtonSair.Enabled := true;
  ButtonSimular.Enabled := true;
  BtnIniciar.Enabled := true;
  ButtonConfigurar.Enabled := true;
  BtnParar.Enabled := false;
  DBNavigator1.Enabled := true;
  ImprimeStatus(nil);
End;

Procedure TFormBackup.DestivarBotoes(Sender: Tobject);
Begin
  ButtonSair.Enabled := false;
  ButtonSimular.Enabled := false;
  BtnIniciar.Enabled := false;
  ButtonConfigurar.Enabled := false;
  BtnParar.Enabled := true;
  DBNavigator1.Enabled := false;
End;

Procedure TFormBackup.ButtonSimularClick(Sender: Tobject);
Begin
  DestivarBotoes(nil);
  MontaComando(nil);
  Comando := Comando + ' --dry-run';
  Comando := Comando + ' ' + DBA.FieldByName('ORIGEM').AsString + ' ' + DBA.FieldByName('DESTINO').AsString;
  IniciarBackup(nil);
  MyThread.TerminarProcesso := false;
End;

Procedure TFormBackup.ButtonSairClick(Sender: Tobject);
Begin
   Close;
End;

Procedure Tformbackup.Formclosequery(Sender: Tobject; Var Canclose: Boolean);
Begin
  if MessageDlg('Deseja realmente sair?', mtConfirmation,[mbYes,mbNo],0) = mrYes then begin
     Canclose := true;
  End;
End;

Procedure Tformbackup.ImprimeStatus(Sender: Tobject);
var
   SaidaProc: integer;
Begin
   SaidaProc := MyThread.StatusSaida;
   if SaidaProc = 0  then begin
       LabelStatus.Caption := 'Success'
   end else if SaidaProc = 1 then begin
       LabelStatus.Caption := 'Syntax or usage error'
   end else if  SaidaProc = 2  then begin
        LabelStatus.Caption := 'Protocol incompatibility'
   end else if  SaidaProc = 3  then begin
        LabelStatus.Caption := 'Errors selecting input/output files, dirs'
   end else if  SaidaProc = 4   then begin
        LabelStatus.Caption := 'Requested action not supported: an attempt was made to manipulate 64-bit files on a platform that cannot support them; or an option was specified that is supported by the client and not by the server.'
   end else if  SaidaProc = 5  then begin
        LabelStatus.Caption := 'Error starting client-server protocol'
   end else if  SaidaProc = 6  then begin
        LabelStatus.Caption := 'Daemon unable to append to log-file'
   end else if  SaidaProc = 10  then begin
        LabelStatus.Caption := 'Error in socket I/O'
   end else if  SaidaProc = 11  then begin
        LabelStatus.Caption := 'Error in file I/O'
   end else if  SaidaProc = 12  then begin
        LabelStatus.Caption := 'Error in rsync protocol data stream'
   end else if  SaidaProc = 13  then begin
        LabelStatus.Caption := 'Errors with program diagnostics'
   end else if  SaidaProc = 14 then begin
        LabelStatus.Caption := ' Error in IPC code'
   end else if  SaidaProc = 20  then begin
        LabelStatus.Caption := ' Received SIGUSR1 or SIGINT'
   end else if  SaidaProc = 21  then begin
        LabelStatus.Caption := 'Some error returned by CWwaitpid()'
   end else if  SaidaProc = 22  then begin
        LabelStatus.Caption := 'Error allocating core memory buffers'
   end else if  SaidaProc = 23  then begin
        LabelStatus.Caption := 'Partial transfer due to error'
   end else if  SaidaProc = 24  then begin
        LabelStatus.Caption := 'Partial transfer due to vanished source files'
   end else if  SaidaProc = 25   then begin
       LabelStatus.Caption := 'The --max-delete limit stopped deletions'
   end else if  SaidaProc = 30   then begin
        LabelStatus.Caption := ' Timeout in data send/receive'
   end else if  SaidaProc = 35  then begin
        LabelStatus.Caption := 'Timeout waiting for daemon connection'
   End;
End;

{ TMyThread }

procedure TMyThread.ShowStatus;
// this method is only called by Synchronize(@ShowStatus) and therefore
// executed by the main thread
// The main thread can access GUI elements, for example FormBackup.Caption.
begin
  FormBackup.Edit1.Text := FormBackup.status;
  //if fStatusText <> '@' then FormBackup.Memo.Lines.Add(fStatusText);
end;

procedure TMyThread.Execute;
var
  oStream          : TStringList;
  oProc            : TProcess;
begin
  oStream := TStringList.Create;
  oProc   := TProcess.Create(Nil);
  oProc.Options  := [poUsePipes];
  oProc.Priority := ppIdle;
  oProc.CommandLine := 'rsync ' + FormBackup.Comando;
  oProc.Execute;

  while oProc.Running do begin
      Sleep(1000);
      oStream.LoadFromStream(oProc.Output);
      StatusSaida := oProc.ExitStatus;
      FormBackup.status := oStream.GetText;
      Synchronize(@Showstatus);
      FormBackup.DestivarBotoes(nil);
      if TerminarProcesso then begin
          oProc.Terminate(1);
      End;
  end;
      StatusSaida := oProc.ExitStatus;
      //limpa variáveis
      oProc.Free;
      oProc := nil;
      oStream.Free;
      oStream := nil;
      //ativa botões novamente
      FormBackup.AtivarBotoes(nil);

      Terminate;
End;

constructor TMyThread.Create(CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

procedure TFormBackup.CriarTabela(Arquivo : String);
begin
  With DBA do
    begin
    Close;
    with FieldDefs do
      begin
      Clear;
      Add('ID',ftInteger,30);
      Add('NOME',ftString,80);
      Add('ORIGEM',ftString,200);
      Add('DESTINO',ftString,200);
      Add('CONFIG_LIM',ftString,30);
      Add('CONFIG_1',ftString,30);
      Add('CONFIG_2',ftString,30);
      Add('CONFIG_3',ftString,30);
      Add('CONFIG_4',ftString,30);
      Add('CONFIG_5',ftString,30);
      Add('CONFIG_6',ftString,30);
      Add('CONFIG_7',ftString,30);
      Add('CONFIG_8',ftString,30);
      Add('CONFIG_9',ftString,30);
      Add('CONFIG_10',ftString,30);
      Add('CONFIG_11',ftString,30);
      Add('CONFIG_12',ftString,30);
      end;
    TableName:=Arquivo;
    CreateTable;
    Exclusive := true;
    end;
end;

initialization
  {$I  ubackup.lrs}

end.

